home *** CD-ROM | disk | FTP | other *** search
/ Archive Magazine CD 1995 / Archive Magazine CD 1995.iso / discs / prog_disc / volume_2 / issue_06 / fontaid / dlaspool < prev    next >
Encoding:
Text File  |  1989-02-13  |  5.1 KB  |  190 lines
  1. >LIST
  2.  
  3.    10 REM > DLASource
  4.  
  5.    20 
  6.  
  7.    30 REM Archimedes Font Downloader module
  8.  
  9.    40 REM (for FontAid font files)
  10.  
  11.    50 
  12.  
  13.    60 REM (C) Richard Averill, January 1989.
  14.  
  15.    70 
  16.  
  17.    80 IF MODE <18 THEN MODE 0 ELSE MODE 18
  18.  
  19.    90 PRINT TAB(15) "Archimedes FontAid font downloader module generator"'
  20.  
  21.   100 PRINT TAB(25) "(C) Richard Averill, 1989."'
  22.  
  23.   110 PRINT TAB(10) "(from Archive magazine, March 1989 (Volume 2 Number 6))"'
  24.  
  25.   120 
  26.  
  27.   130 DIM code% 4000
  28.  
  29.   140 PRINT "Assembling code ...";:PROCassemble:PRINT '
  30.  
  31.   150 INPUT "Filename to save module under (Return=""FontModule"") : " module$
  32.  
  33.   160 IF module$="" THEN module$="FontModule"
  34.  
  35.   170 SYS "OS_File",&0A,module$,&FFA,0,code%,O%
  36.  
  37.   180 PRINT "Module saved as """;module$;""""
  38.  
  39.   190 
  40.  
  41.   200 END
  42.  
  43.   210 
  44.  
  45.   220 DEF PROCassemble
  46.  
  47.   230 sp=13 : link=14 : pc=15:XWriteI%=&20100
  48.  
  49.   240 FOR opt%=4 TO 6 STEP 2
  50.  
  51.   250   P%=0:O%=code%
  52.  
  53.   260   [ OPT opt%
  54.  
  55.   270   equd    0
  56.  
  57.   280   equd    ptrinit
  58.  
  59.   290   equd    0
  60.  
  61.   300   equd    0
  62.  
  63.   310   equd    strtitle
  64.  
  65.   320   equd    strhelp
  66.  
  67.   330   equd    tblcommands
  68.  
  69.   340   equs    STRING$(20,CHR$(0))
  70.  
  71.   350   
  72.  
  73.   360   .strtitle FNstr("FontDownLoader")
  74.  
  75.   370   
  76.  
  77.   380   .strhelp FNstr("FontDownLoader"+CHR$(9)+"1.00 ("+MID$(TIME$,5,11)+") (C) Richard Averill, January 1989.")
  78.  
  79.   390   
  80.  
  81.   400   .ptrinit
  82.  
  83.   410   stmfd   (sp)!, {link}
  84.  
  85.   420   
  86.  
  87.   430   mov     r0, #6
  88.  
  89.   440   mov     r3, #8192
  90.  
  91.   450   swi     "XOS_Module"
  92.  
  93.   460   
  94.  
  95.   470   bvs     init_exit
  96.  
  97.   480   
  98.  
  99.   490   str     r2, [r12]
  100.  
  101.   500   mov     r2, #0
  102.  
  103.   510   add     r2, r2, #7168
  104.  
  105.   520   str     r0, [r2]
  106.  
  107.   530   
  108.  
  109.   540   swi     "XOS_WriteS"
  110.  
  111.   550   FNnla(  "Font-DownLoader v1.00 (C) Richard Averill, January 1989, installed.")
  112.  
  113.   560   
  114.  
  115.   570   .init_exit ldmfd (sp)!, {pc}
  116.  
  117.   580   
  118.  
  119.   590   .dla
  120.  
  121.   600   ldr     r2, [r12]
  122.  
  123.   610   cmp     r2, #0
  124.  
  125.   620   moveqs  pc, link
  126.  
  127.   630   
  128.  
  129.   640   stmfd   (sp)!, {link}
  130.  
  131.   650   stmfd   (sp)!, {r2}
  132.  
  133.   660   ldrb    r2, [r0]
  134.  
  135.   670   tst     r2, #&20
  136.  
  137.   680   biceq   r2, r2, #&20
  138.  
  139.   690   cmp     r2, #ASC("P")
  140.  
  141.   700   bne     not_proportional
  142.  
  143.   710   ldrb    r2, [r0, #1]
  144.  
  145.   720   cmp     r2, #32
  146.  
  147.   730   bgt     not_proportional
  148.  
  149.   740   
  150.  
  151.   750   .jumpover_loop
  152.  
  153.   760   ldrb    r2, [r0], #1
  154.  
  155.   770   cmp     r2, #32
  156.  
  157.   780   ble     jumpover_loop
  158.  
  159.   790   
  160.  
  161.   800   stmfd   (sp)!, {r0}
  162.  
  163.   810   adr     r0, proportional_codes
  164.  
  165.   820   swi     "XOS_Write0"
  166.  
  167.   830   ldmfd   (sp)!, {r0}
  168.  
  169.   840   sub     r1, r1, #1
  170.  
  171.   850   
  172.  
  173.   860   .not_proportional
  174.  
  175.   870   ldmfd   (sp)!, {r2}
  176.  
  177.   880   cmp     r1, #0
  178.  
  179.   890   bne     havetoload
  180.  
  181.   900   
  182.  
  183.   910   ldr     r2, [r12]
  184.  
  185.   920   add     r2, r2, #7168
  186.  
  187.   930   ldr     r2, [r2]
  188.  
  189.   940   cmp     r2, #0
  190.  
  191.   950   adreq   r0, msg_nofont
  192.  
  193.   960   ldmeqfd (sp)!, {link}
  194.  
  195.   970   orreq   link, link, #(1<<28)
  196.  
  197.   980   moveqs  pc, link
  198.  
  199.   990   b       download
  200.  
  201.  1000   
  202.  
  203.  1010   .havetoload
  204.  
  205.  1020   mov     r1, r0
  206.  
  207.  1030   mov     r0, #&40
  208.  
  209.  1040   mov     r2, #0
  210.  
  211.  1050   
  212.  
  213.  1060   swi     "XOS_Find"
  214.  
  215.  1070   
  216.  
  217.  1080   cmp     r0, #0
  218.  
  219.  1090   adreq   r0, msg_nofont
  220.  
  221.  1100   ldmeqfd (sp)!, {link}
  222.  
  223.  1110   orreq   link, link, #(1<<28)
  224.  
  225.  1120   moveqs  pc, link
  226.  
  227.  1130   
  228.  
  229.  1140   .file_found
  230.  
  231.  1150   mov     r1, r0
  232.  
  233.  1160   mov     r0, #3
  234.  
  235.  1170   ldr     r2, [r12]
  236.  
  237.  1180   mov     r3, #6144
  238.  
  239.  1190   mov     r4, #0
  240.  
  241.  1200   
  242.  
  243.  1210   swi     "XOS_GBPB"
  244.  
  245.  1220   
  246.  
  247.  1230   mov     r0, #1
  248.  
  249.  1240   ldr     r1, [r12]
  250.  
  251.  1250   add     r1, r1, #7168
  252.  
  253.  1260   str     r0, [r1]
  254.  
  255.  1270   
  256.  
  257.  1280   .download
  258.  
  259.  1290   swi     XWriteI%+2
  260.  
  261.  1300   
  262.  
  263.  1310   adr     r1, pre_dla
  264.  
  265.  1320   add     r2, r1, #14
  266.  
  267.  1330   .pre_loop
  268.  
  269.  1340   ldrb    r0, [r1], #1
  270.  
  271.  1350   swivc   XWriteI%+1
  272.  
  273.  1360   swivcs  "XOS_WriteC"
  274.  
  275.  1370   bvs     dlaexit
  276.  
  277.  1380   cmp     r1, r2
  278.  
  279.  1390   blt     pre_loop
  280.  
  281.  1400   
  282.  
  283.  1410   ldr     r1, [r12]
  284.  
  285.  1420   add     r2, r1, #6144
  286.  
  287.  1430   .dla_loop
  288.  
  289.  1440   ldrb    r0, [r1], #1
  290.  
  291.  1450   swis    XWriteI%+1
  292.  
  293.  1460   swivcs  "XOS_WriteC"
  294.  
  295.  1470   bvs     dlaexit
  296.  
  297.  1480   cmp     r1, r2
  298.  
  299.  1490   blt     dla_loop
  300.  
  301.  1500   
  302.  
  303.  1510   .dlaexit
  304.  
  305.  1520   swi     XWriteI%+3
  306.  
  307.  1530   LDMFD   (sp)!, {pc}
  308.  
  309.  1540   
  310.  
  311.  1550   .pre_dla equd  &251B281B : equd &521B0001 : equd &261B00 : equd &7F00
  312.  
  313.  1560   
  314.  
  315.  1570   .proportional_codes equd  &011B0102 : equd &03010170 : equd 0
  316.  
  317.  1580   
  318.  
  319.  1590   .msg_nofont
  320.  
  321.  1600   equd  &D6 : FNstr("Font file not found")
  322.  
  323.  1610   
  324.  
  325.  1620   .tblcommands
  326.  
  327.  1630   FNstr("DLA")
  328.  
  329.  1640   equd  dla : equd &20100 : equd syndla : equd hlpdla : equd 0
  330.  
  331.  1650   
  332.  
  333.  1660   .hlpdla
  334.  
  335.  1670   equs  "Font-DownLoader, (C) Richard Anthony Averill, January 1989."+CHR$(13)+CHR$(13)
  336.  
  337.  1680   equs  "*DLA downloads FontAid font files to Canon-type NLQ printers."+CHR$(13)
  338.  
  339.  1690   equs  "The P prefix, when present, causes proportional spacing to be enabled."+CHR$(13)
  340.  
  341.  1700   equs "If no font file is given, the previous downloaded font will be re-downloaded."+CHR$(13)
  342.  
  343.  1710   .syndla
  344.  
  345.  1720   FNstr("Syntax: *DLA [P] [<font file>].")
  346.  
  347.  1730   ]
  348.  
  349.  1740 NEXT opt%
  350.  
  351.  1750 ENDPROC
  352.  
  353.  1760 
  354.  
  355.  1770 DEF FNstr(str$)
  356.  
  357.  1780 [ OPT opt% AND &E
  358.  
  359.  1790 equs    str$ + CHR$(0)
  360.  
  361.  1800 align
  362.  
  363.  1810 ] :=opt%
  364.  
  365.  1820 
  366.  
  367.  1830 DEF FNnla(str$)
  368.  
  369.  1840 [ OPT opt% AND &E
  370.  
  371.  1850 equs    str$ + CHR$(10) + CHR$(13) + CHR$(0)
  372.  
  373.  1860 align
  374.  
  375.  1870 ] :=opt%
  376.  
  377. >*SPOO.L
  378.  
  379.